home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 11 / Cream of the Crop 11-1.iso / comm / tcp4w15.zip / USETCP4W.PAS < prev   
Pascal/Delphi Source File  |  1995-06-08  |  9KB  |  222 lines
  1. Unit UseTCP4W;
  2. { * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * }
  3. {                                                                 }
  4. {                                                                 }
  5. {                                                                 }
  6. {   TCP4W.DLL  (Version 1.0)                                      }
  7. {                                                                 }
  8. {                                                                 }
  9. {                                                   By Ph. Jounin }
  10. {                                        Internet ark@ifh.sncf.fr }
  11. { * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * }
  12. {  Pascal Interface written by Andreas Tikart AStA Uni Konstanz   }
  13. {  (Andreas.Tikart@uni-konstanz.de) in cooperation with Polarwolf }
  14. { * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * }
  15.  
  16. Interface
  17.  
  18. Uses WinTypes, WinProcs;
  19.  
  20. Type PSocket = ^TSocket;
  21.      TSocket = THandle;
  22.  
  23.      TIP = Record
  24.        Case Byte Of
  25.          0: (B1, B2, B3, B4: Byte);
  26.          1: (L: Longint);
  27.        End;
  28.  
  29. Const
  30. { ------------------------------- }
  31. { Return codes of TCP4W functions }
  32. { ------------------------------- }
  33. IP_SUCCESS         =  1;  { >=1 function OK            }
  34. IP_ERROR           = -1;  { error                      }
  35. IP_TIMEOUT         = -2;  { timeout has occured        }
  36. IP_BUFFERFREED     = -3;  { the buffer has been freed  }
  37. IP_HOSTUNKNOWN     = -4;  { connect to unknown host    }
  38. IP_NOMORESOCKET    = -5;  { all socket has been used   }
  39. IP_NOMORERESOURCE  = -5;  { or no more free resource   }
  40. IP_CONNECTFAILED   = -6;  { connect function has failed}
  41. IP_UNMATCHEDLENGTH = -7;  { TcpPPRecv : Error in length}
  42. IP_BINDERROR       = -8;  { bind failed (Task already started?) }
  43. IP_OVERFLOW        = -9;  { Overflow during TcpPPRecv  }
  44. IP_EMPTYBUFFER     =-10;  { TcpPPRecv receives 0 byte  }
  45. IP_CANCELLED       =-11;  { Call cancelled by TcpAbort }
  46. IP_INSMEMORY       =-12;  { Not enough memory          }
  47. IP_SOCKETCLOSED    =  0;  { Host has close connection  }
  48.  
  49. { ------------------------------ }
  50. { Return codes of TN4W functions }
  51. { ------------------------------ }
  52. TN_SUCCESS       =  IP_SUCCESS;
  53. TN_ERROR         =  IP_ERROR;
  54. TN_TIMEOUT       =  IP_TIMEOUT;
  55. TN_BUFFERFREED   =  IP_BUFFERFREED;
  56. TN_SOCKETCLOSED  =  IP_SOCKETCLOSED;
  57. TN_OVERFLOW      = 2;
  58.  
  59. Type
  60. { ------------------------------------------------- }
  61. { Registration functions                            }
  62. { ------------------------------------------------- }
  63. TTcp4wInit = Function: Integer;
  64. TTcp4wCleanup = Function: Integer;
  65. TTcp4wVer = Function (szVerStr: PChar; nStrSize: Integer): Integer;
  66.  
  67. { ------------------------------------------------- }
  68. { TCP functions                                     }
  69. { ------------------------------------------------- }
  70. TTcpAbort = Function: Integer;
  71. TTcpAccept = Function (Var CSock: TSocket; ListenSock: TSocket; nTO: Integer): Integer;
  72. TTcpConnect = Function (Var S: TSocket; szServer, szService: PChar; Var lpPort: Integer): Integer;
  73. TTcpClose = Function (Var S: TSocket): Integer;
  74. TTcpFlush = Function (S: TSocket): Integer;
  75. TTcpGetListenSocket = Function (Var S: TSocket; szService: PChar; Var lpPort: Integer; nPendingConnection: Integer): Integer;
  76. TTcpGetLocalID = Function (szStrName: PChar; NameSize: Integer; Var lpAddress: TIP): Integer;
  77. TTcpGetRemoteID = Function (S: TSocket; szStrName: PChar; NameSize: Integer; Var lpAddress: TIP): Integer;
  78. TTcpRecv = Function (S: TSocket; szBuf: PChar; BufSize, TimeOut: Integer; hf: Integer): Integer;
  79. TTcpSend = Function (S: TSocket; szBuf: PChar; BufSize: Integer; bHighPriority: Bool; hf: Integer): Integer;
  80. TTcpIsDataAvail = Function (S: TSocket): Integer;
  81.  
  82. { PP protocole (2 first bytes contain length of data) }
  83. TTcpPPRecv = Function (S: TSocket; szBuf: PChar; BufSize, TimeOut: Integer; bExact: Bool; hLogFile: Integer): Integer;
  84. TTcpPPSend = Function (S: TSocket; szBuf: PChar; BufSize: Integer; hLogFile: Integer): Integer;
  85.  
  86. TTcpRecvUntilStr = Function (S: TSocket; szBuf: PChar; Var lpBufSize: Integer;
  87.     szStop: PChar; StopSize: Integer; bCaseSensitive: Bool; TimeOut: Integer; hLogFile: Integer): Integer;
  88.  
  89. { ------------------------------------------------- }
  90. { Telnet functions                                  }
  91. { ------------------------------------------------- }
  92. TTnReadLine = Function (S: TSocket; szBuf: PChar; BufSize, TimeOut: Integer; hf: Integer): Integer;
  93. TTnSend = Function (S: TSocket; szString: PChar; bHighPriority: Bool; hf: Integer): Integer;
  94. TTnGetAnswerCode = Function (ctrl_skt: TSocket; szInBuf: PChar; BufSize, TimeOut: Integer; hf: Integer): Integer;
  95.  
  96. Var
  97. { ------------------------------------------------- }
  98. { Var's                                             }
  99. { ------------------------------------------------- }
  100. Tcp4wInit: TTcp4wInit;
  101. Tcp4wCleanup: TTcp4wCleanup;
  102. Tcp4wVer: TTcp4wVer;
  103. TcpAbort: TTcpAbort;
  104. TcpAccept: TTcpAccept;
  105. TcpConnect: TTcpConnect;
  106. TcpClose: TTcpClose;
  107. TcpFlush: TTcpFlush;
  108. TcpGetListenSocket: TTcpGetListenSocket;
  109. TcpGetLocalID: TTcpGetLocalID;
  110. TcpGetRemoteID: TTcpGetRemoteID;
  111. TcpRecv: TTcpRecv;
  112. TcpSend: TTcpSend;
  113. TcpIsDataAvail: TTcpIsDataAvail;
  114. TcpPPRecv: TTcpPPRecv;
  115. TcpPPSend: TTcpPPSend;
  116. TcpRecvUntilStr: TTcpRecvUntilStr;
  117. TnReadLine: TTnReadLine;
  118. TnSend: TTnSend;
  119. TnGetAnswerCode: TTnGetAnswerCode;
  120.  
  121. {Extra Functions}
  122. Function  TCP4W_Error (ErrorValue: Integer): PChar;
  123.  
  124. Implementation
  125.  
  126. Var hTcp4w: THandle;
  127.     SaveExitProc : Pointer;
  128.  
  129. Procedure OpenTcp4wDLL;
  130.   Var FP: TFarProc;
  131.   Begin
  132.     hTcp4w := LoadLibrary ('TCP4W.DLL');
  133.     If hTcp4w < 32 Then Exit;
  134.     FP := GetProcAddress (hTcp4W, 'Tcp4wInit');
  135.     Tcp4wInit := TTcp4wInit (FP);
  136.     FP := GetProcAddress (hTcp4W, 'Tcp4wCleanup');
  137.     Tcp4wCleanup := TTcp4wCleanup (FP);
  138.     FP := GetProcAddress (hTcp4W, 'Tcp4wVer');
  139.     Tcp4wVer := TTcp4wVer (FP);
  140.     FP := GetProcAddress (hTcp4W, 'TcpAbort');
  141.     TcpAbort := TTcpAbort (FP);
  142.     FP := GetProcAddress (hTcp4W, 'TcpAccept');
  143.     TcpAccept := TTcpAccept (FP);
  144.     FP := GetProcAddress (hTcp4W, 'TcpConnect');
  145.     TcpConnect := TTcpConnect (FP);
  146.     FP := GetProcAddress (hTcp4W, 'TcpClose');
  147.     TcpClose := TTcpClose (FP);
  148.     FP := GetProcAddress (hTcp4W, 'TcpFlush');
  149.     TcpFlush := TTcpFlush (FP);
  150.     FP := GetProcAddress (hTcp4W, 'TcpGetListenSocket');
  151.     TcpGetListenSocket := TTcpGetListenSocket (FP);
  152.     FP := GetProcAddress (hTcp4W, 'TcpGetLocalID');
  153.     TcpGetLocalID := TTcpGetLocalID (FP);
  154.     FP := GetProcAddress (hTcp4W, 'TcpGetRemoteID');
  155.     TcpGetRemoteID := TTcpGetRemoteID (FP);
  156.     FP := GetProcAddress (hTcp4W, 'TcpRecv');
  157.     TcpRecv := TTcpRecv (FP);
  158.     FP := GetProcAddress (hTcp4W, 'TcpSend');
  159.     TcpSend := TTcpSend (FP);
  160.     FP := GetProcAddress (hTcp4W, 'TcpIsDataAvail');
  161.     TcpIsDataAvail := TTcpIsDataAvail (FP);
  162.     FP := GetProcAddress (hTcp4W, 'TcpPPRecv');
  163.     TcpPPRecv := TTcpPPRecv (FP);
  164.     FP := GetProcAddress (hTcp4W, 'TcpPPSend');
  165.     TcpPPSend := TTcpPPSend (FP);
  166.     FP := GetProcAddress (hTcp4W, 'TcpRecvUntilStr');
  167.     TcpRecvUntilStr := TTcpRecvUntilStr (FP);
  168.     FP := GetProcAddress (hTcp4W, 'TnReadLine');
  169.     TnReadLine := TTnReadLine (FP);
  170.     FP := GetProcAddress (hTcp4W, 'TnSend');
  171.     TnSend := TTnSend (FP);
  172.     FP := GetProcAddress (hTcp4W, 'TnGetAnswerCode');
  173.     TnGetAnswerCode := TTnGetAnswerCode (FP);
  174.   End;
  175.  
  176. Function TCP4W_Error (ErrorValue: Integer): PChar;
  177.   {return a PChar related to the ErrorValue given}
  178.   {as a parameter}
  179.   Var Msg: PChar;
  180.   Begin
  181.     Case ErrorValue Of
  182.         IP_ERROR           : Msg :=  'error';
  183.         IP_TIMEOUT         : Msg :=  'timeout has occured';
  184.         IP_BUFFERFREED     : Msg :=  'the buffer has been freed';
  185.         IP_HOSTUNKNOWN     : Msg :=  'connect to unknown host';
  186.         IP_NOMORESOCKET    : Msg :=  'all socket has been used';
  187.         IP_NOMORERESOURCE  : Msg :=  'or no more free resource';
  188.         IP_CONNECTFAILED   : Msg :=  'connect function has failed';
  189.         IP_UNMATCHEDLENGTH : Msg :=  'Error in length';
  190.         IP_BINDERROR       : Msg :=  'bind failed (Task already started?)';
  191.         IP_OVERFLOW        : Msg :=  'Overflow during TcpPPRecv';
  192.         IP_EMPTYBUFFER     : Msg :=  'TcpPPRecv receives 0 byte';
  193.         IP_CANCELLED       : Msg :=  'Call cancelled by TcpAbort';
  194.         IP_INSMEMORY       : Msg :=  'Not enough memory';
  195.         IP_SOCKETCLOSED    : Msg :=  'Host has close connection';
  196.       Else Msg := 'Unknown Error';
  197.       End;
  198.     TCP4W_Error := MSG;
  199.   End;
  200.  
  201. Procedure MyExitProc; Far;
  202.   Begin
  203.     ExitProc := SaveExitProc;
  204.     If hTcp4W >= 32 Then
  205.       Begin
  206.         Tcp4WCleanUp;
  207.         FreeLibrary (hTcp4W);
  208.       End;
  209.   End;
  210.  
  211. Begin
  212.   hTcp4W := 0;
  213.   SaveExitProc := ExitProc;
  214.   ExitProc := @MyExitProc;
  215.   OpenTcp4wDLL;
  216.   If hTcp4W < 32 Then
  217.     Begin
  218.       MessageBox (0, 'TCP4W not found', '', mb_IconStop + mb_SystemModal + mb_Ok);
  219.       Halt
  220.     End
  221. End.
  222.